Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-06/segue.exe/BD_DEMO.PRG

Text File | 1991-07-24 | 27KB | 1,221 lines

*.............................................................................
*   Program Name: BD_DEMO.PRG       Copyright: HRF Associates, Inc.
*   Date Created: 05/05/91           Language: Clipper
*   Time Created: 20:27:54             Author: Bob Fogle
*.............................................................................
* NOTE: The following code was written for demo purposes, not for efficiency.
*
mLASTCOLOR  = SETCOLOR()
mLASTSCREEN = SAVESCREEN(00,00,24,79)
mLASTCURROW = ROW()
mLASTCURCOL = COL()
end_flag = .F.
SET wrap ON
SET message TO 23 center

DO WHILE .T.
  DO MNU
  IF end_flag
    @ mLASTCURROW-2,mLASTCURCOL
    RESTSCREEN(00,00,24,79,mLASTSCREEN)
    SETCOLOR(mLASTCOLOR)
    RETURN
  ENDIF
ENDDO

PROCEDURE MNU
LOCAL mCHOICE :=1
SETCOLOR(if(iscolor()=.F.,NOCOLOR,"BG+/B,B/W+,,,W+/B"))
CLEAR
@ 00,00 TO 24,79 DOUBLE
@ 03,48 TO 16,77
@ 03,55 SAY " SEGUE SUPPLEMENT "
@ 00,25 SAY " SEGUE BINDERY SERVICES DEMO "
xx=3
@  xx, 3 SAY "Select SEGUE API to demo:"
xx=xx+2
@ xx,10 PROMPT "Exit"        MESSAGE "Return to Main Menu"       //1
xx=xx+1
@ xx,10 PROMPT "BDOBAD()"    MESSAGE "Create Object"             //2
xx=xx+1
@ xx,10 PROMPT "BDOBDL()"    MESSAGE "Delete Object"             //3
xx=xx+1
@ xx,10 PROMPT "BDOBRN()"    MESSAGE "Rename Object"             //4
xx=xx+1
@ xx,10 PROMPT "BDOBID()"    MESSAGE "Get Object ID"             //5
xx=xx+1
@ xx,10 PROMPT "BDOBNM()"    MESSAGE "Get Object Name"           //6
xx=xx+1
@ xx,10 PROMPT "BDPTAD()"    MESSAGE "Create Property"           //7
xx=xx+1
@ xx,10 PROMPT "BDPTDL()"    MESSAGE "Delete Property"           //8
xx=xx+1
@ xx,10 PROMPT "BDPTVLWR()"  MESSAGE "Write Property Value"      //9
xx=xx+1
@ xx,10 PROMPT "BDPTVLRD()"  MESSAGE "Read Property Value"       //10
xx=xx+1
@ xx,10 PROMPT "BDPTOBAD()"  MESSAGE "Add Object To Set"         //11
xx=xx-10
@ xx,30 PROMPT "BDPTOBCK()"  MESSAGE "Is Object In Set"          //12
xx=xx+1
@ xx,30 PROMPT "BDPTOBDL()"  MESSAGE "Delete Object From Set"    //13
xx=xx+1
@ xx,30 PROMPT "BDOBPWCH()"  MESSAGE "Change Object Password"    //14
xx=xx+1
@ xx,30 PROMPT "BDOBPWVY()"  MESSAGE "Verify Object Password"    //15
xx=xx+1
@ xx,30 PROMPT "BDOBCHSY()"  MESSAGE "Change Object Security"    //16
xx=xx+1
@ xx,30 PROMPT "BDPTCHSY()"  MESSAGE "Change Property Security"  //17
xx=xx+1
@ xx,30 PROMPT "BDOBSN()"    MESSAGE "Scan Object"               //18
xx=xx+1
@ xx,30 PROMPT "BDPTSN()"    MESSAGE "Scan Property"             //19
xx=xx+1
@ xx,30 PROMPT "BDALG()"     MESSAGE "Get Bindery Access Level"  //20
xx=xx+1
@ xx,30 PROMPT "BDOP()"      MESSAGE "Open Bindery"              //21
xx=xx+1
@ xx,30 PROMPT "BDCL()"      MESSAGE "Close Bindery"             //22
xx=xx-10
@ xx,50 PROMPT "USRAD_()"    MESSAGE "SS Add User"               //23
xx=xx+1
@ xx,50 PROMPT "USRDL_()"    MESSAGE "SS Delete User"            //24
xx=xx+1
@ xx,50 PROMPT "USRSLST_()"  MESSAGE "SS List Users"             //25
xx=xx+1
@ xx,50 PROMPT "USRGRPLST_()" MESSAGE "SS List User's Groups"    //26
xx=xx+1
@ xx,50 PROMPT "USRINGRP_()" MESSAGE "SS Is User In Group"       //27
xx=xx+1
@ xx,50 PROMPT "GRPAD_()"    MESSAGE "SS Add Group"              //28
xx=xx+1
@ xx,50 PROMPT "GRPDL_()"    MESSAGE "SS Delete Group"           //29
xx=xx+1
@ xx,50 PROMPT "GRPSLST_()"  MESSAGE "SS List Groups"            //30
xx=xx+1
@ xx,50 PROMPT "GRPUSRLST_()" MESSAGE "SS List Group's Users"    //31
xx=xx+1
@ xx,50 PROMPT "GRPUSRAD_()" MESSAGE "SS Add User To Group"      //32
xx=xx+1
@ xx,50 PROMPT "GRPUSRDL_()" MESSAGE "SS Delete User From Group" //33
xx=xx-10
@ xx,64 PROMPT "SUPLST_()" MESSAGE "SS List Users w/Supervisor Security" //34
xx=xx+1

MENU TO mCHOICE
//
DO CASE
  CASE mCHOICE = 0 .or. mCHOICE = 1
    end_flag=.T.
  CASE mCHOICE = 2
    DO NBDOBAD      // Demo FUNCTION PROCEDURE name
  CASE mCHOICE = 3
    DO NBDOBDL
  CASE mCHOICE = 4
    DO NBDOBRN
  CASE mCHOICE = 5
    DO NBDOBID
  CASE mCHOICE = 6
    DO NBDOBNM
  CASE mCHOICE = 7
    DO NBDPTAD
  CASE mCHOICE = 8
    DO NBDPTDL
  CASE mCHOICE = 9
    DO NBDPTVLWR
  CASE mCHOICE = 10
    DO NBDPTVLRD
  CASE mCHOICE = 11
    DO NBDPTOBAD
  CASE mCHOICE = 12
    DO NBDPTOBCK
  CASE mCHOICE = 13
    DO NBDPTOBDL
  CASE mCHOICE = 14
    DO NBDOBPWCH
  CASE mCHOICE = 15
    DO NBDOBPWVY
  CASE mCHOICE = 16
    DO NBDOBCHSY
  CASE mCHOICE = 17
    DO NBDPTCHSY
  CASE mCHOICE = 18
    DO NBDOBSN
  CASE mCHOICE = 19
    DO NBDPTSN
  CASE mCHOICE = 20
    DO NBDALG
  CASE mCHOICE = 21
    DO NBDOP
  CASE mCHOICE = 22
    DO NBDCL
  CASE mCHOICE = 23
    DO USRAD
  CASE mCHOICE = 24
    DO USRDL
  CASE mCHOICE = 25
    DO USRSLST
  CASE mCHOICE = 26
    DO USRGRPLST
  CASE mCHOICE = 27
    DO USRINGRP
  CASE mCHOICE = 28
    DO GRPAD
  CASE mCHOICE = 29
    DO GRPDL
  CASE mCHOICE = 30
    DO GRPSLST
  CASE mCHOICE = 31
    DO GRPUSRLST
  CASE mCHOICE = 32
    DO GRPUSRAD
  CASE mCHOICE = 33
    DO GRPUSRDL
  CASE mCHOICE = 34
    DO SUPLST
ENDCASE
RETURN

PROCEDURE INTRO
PUBLIC XX
CLEAR
xx=ROW()
xx=xx+1
@ xx, 0 SAY "Demo for "+mDEMO+" API"
xx=xx+2
@ xx, 0
RETURN

PROCEDURE CHKRTNUM
PARAMETERS rtn
IF rtn<0
  ? "Error: ", rtn
ELSE
  @ 23,0 SAY "Successful ! ... Use SYSCON to check."
ENDIF
WAIT
RETURN

PROCEDURE CHKRTNUM1
PARAMETERS rtn
IF rtn<0
  ? "Error: ", rtn
ELSE
  @ 23,0 SAY "Successful ! ...."
ENDIF
WAIT
RETURN

PROCEDURE CHKRTNUM2
PARAMETERS rtn
IF rtn<0
  ? "Error: ", rtn
  WAIT
  OK=.F.
elseif mCNT
  ? "Count = ", LTRIM(STR(rtn))
  WAIT
  OK=.F.
ENDIF
RETURN

PROCEDURE CHKRTNUM3
PARAMETERS rtn
IF rtn<0
  ? "Error: ", rtn
  WAIT
  OK=.F.
ENDIF
RETURN

PROCEDURE CHKRTNUM4
PARAMETERS rtn
IF rtn<0
  ? "No, because: ", rtn
ELSE
  @ 23,0 SAY "Yes ! ...."
ENDIF
WAIT
RETURN

PROCEDURE NBDOBAD
LOCAL mobtyp, mobnm, mobid, mobflag, mobwsy, mobrsy, rtn, mcnt
PRIVATE mDEMO := "BDOBAD(), Create Object"
rtn=0
DO intro
mOBTYP = 1
@ xx, 0 SAY "Enter Object's type: " GET mOBTYP
READ
xx=xx+1
mOBNM="SEGUE"+SPACE(41)
@ xx, 0 SAY "Enter Object Name: " GET mOBNM
READ
xx=xx+1
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+1
mOBFLAG = 0
@ xx, 0 SAY "Enter Object Flag (0=STATIC, 1=DYNAMIC): " GET mOBFLAG
READ
xx=xx+1
mOBWSY = 'WS'
@ xx, 0 SAY "Enter Object's Write Security: " GET mOBWSY
READ
xx=xx+1
@ xx, 0
mOBRSY = 'RL'
@ xx, 0 SAY "Enter Object's Read Security: " GET mOBRSY
READ
xx=xx+1

rtn = BDOBAD(mOBTYP, mOBNM, mOBFLAG, mOBWSY, mOBRSY )
DO chkrtnum WITH rtn
RETURN

PROCEDURE NBDOBDL
LOCAL mOBTYP, mOBNM
PRIVATE mDEMO := "BDOBDL(), Delete Object"
rtn=0
DO intro
mOBTYP = 1
@ xx, 0 SAY "Enter Object's type: " GET mOBTYP
READ
xx=xx+1
@ xx, 0
mOBNM="SEGUE"+SPACE(41)
@ xx, 0 SAY "Enter Object Name: " GET mOBNM
READ
xx=xx+1
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+2

rtn = BDOBDL(mOBTYP, mOBNM)
DO chkrtnum WITH rtn
RETURN

PROCEDURE NBDOBRN
LOCAL mOBTYP, mOBNM, mOBNM2
PRIVATE mDEMO := "BDOBRN(), Rename Object"
rtn=0
DO intro
mOBTYP = 1
@ xx, 0 SAY "Enter Object's type: " GET mOBTYP
READ
xx=xx+1
mOBNM="SEGUE"+SPACE(41)
@ xx, 0 SAY "Enter Object Name: " GET mOBNM
READ
xx=xx+1
mOBNM = LTRIM(RTRIM(mOBNM))
mOBNM2="SEGUE-NC"+SPACE(40)
@ xx, 0 SAY "Enter Object Name: " GET mOBNM2
READ
xx=xx+1
mOBNM2 = LTRIM(RTRIM(mOBNM2))

rtn = BDOBRN(mOBTYP, mOBNM, mOBNM2)
DO chkrtnum WITH rtn
RETURN

PROCEDURE NBDOBID
LOCAL obtyp, obnm
PRIVATE mDEMO := "BDOBID(), Get Object ID"
rtn=0
DO intro
mOBTYP = 1
@ xx, 0 SAY "Enter Object's type: " GET mOBTYP
READ
xx=xx+1
@ xx, 0
mOBNM="SEGUE"+SPACE(41)
@ xx, 0 SAY "Enter Object Name: " GET mOBNM
READ
xx=xx+1
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+2

rtn = BDOBID(mOBTYP, mOBNM)
IF rtn<0
  ? "Error: ", rtn
ELSE
  @ 23,0 SAY "ID = "+TRANSFORM(rtn,"#############")
ENDIF
WAIT
RETURN

PROCEDURE NBDOBNM
LOCAL obid, obnm, rtn
PRIVATE mDEMO :="BDOBNM(), Get Object Name"
rtn=''
DO intro
mOBID = IF (BDOBID("SEGUE")>0,BDOBID("SEGUE"),0)
@ xx, 0 SAY "Enter Object's ID (numeric long): " GET mOBID
READ
xx=xx+1
rtn = BDOBNM(mOBID)
IF ASC(rtn)>122
  ? "Error: ", -ASC(rtn)
ELSE
  @ 23,0 SAY "NAME = " + rtn
ENDIF
WAIT
RETURN

PROCEDURE NBDPTAD
LOCAL mOBTYP, mOBNM, mPTNMm, PTTYP, mPTFLG, mPTWSY, mPTRSY, rtn
PRIVATE mDEMO := "BDPTAD(), Create Property"
rtn="" //0
DO intro
mOBTYP = 1
@ xx, 0 SAY "Enter Object type: " GET mOBTYP
READ
xx=xx+1
@ xx, 0
mOBNM="SEGUE"+SPACE(41)
@ xx, 0 SAY "Enter Object Name: " GET mOBNM
READ
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+1
mPTNM="IDENTIFICATION"+SPACE(17)
@ xx, 0 SAY "Enter Property Name: " GET mPTNM
READ
mPTNM  = LTRIM(RTRIM(mPTNM))
xx=xx+1
mPTTYP = 0
@ xx, 0 SAY "Enter Property Type: " GET mPTTYP
READ
xx=xx+1
mPTFLG = 0
@ xx, 0 SAY "Enter Property Flag: " GET mPTFLG
READ
xx=xx+1
mPTWSY = 'WS'
@ xx, 0 SAY "Enter Property Write Security: " GET mPTWSY
READ
xx=xx+1
@ xx, 0
mPTRSY = 'RL'
@ xx, 0 SAY "Enter Property Read Security: " GET mPTRSY
READ
xx=xx+1

rtn = BDPTAD(mOBTYP, mOBNM, mPTNM, mPTTYP, mPTFLG, mPTWSY, mPTRSY)
DO chkrtnum1 WITH rtn
RETURN

PROCEDURE NBDPTDL
LOCAL mOBTYP, mOBNM, mPTNM, rtn
PRIVATE mDEMO := "BDPTDL(), Delete Property"
rtn=0
DO intro
mOBTYP = 1
@ xx, 0 SAY "Enter Object type: " GET mOBTYP
READ
xx=xx+1
@ xx, 0
mOBNM="SEGUE"+SPACE(41)
@ xx, 0 SAY "Enter Object Name: " GET mOBNM
READ
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+1
mPTNM="IDENTIFICATION"+SPACE(7)
@ xx, 0 SAY "Enter Property Name: " GET mPTNM
READ
mPTNM  = LTRIM(RTRIM(mPTNM))
xx=xx+1

rtn = BDPTDL(mOBTYP, mOBNM, mPTNM)
DO chkrtnum WITH rtn
RETURN

PROCEDURE NBDPTVLWR
LOCAL  mOBTYP, mOBNM, mSEGNO, mMORESEG, mPTNM, mPTVL, rtn
PRIVATE mDEMO :="BDPTVLWR(), Write Property Value"
rtn=0
DO intro
mOBTYP = 1
@ xx, 0 SAY "Enter Object's type: " GET mOBTYP
READ
xx=xx+1
@ xx, 0
mOBNM="SEGUE"+SPACE(41)
@ xx, 0 SAY "Enter Object Name: " GET mOBNM
READ
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+1
mPTNM="IDENTIFICATION"+SPACE(7)
@ xx, 0 SAY "Enter Property Name: " GET mPTNM
READ
mPTNM  = LTRIM(RTRIM(mPTNM))
xx=xx+1
mSEGNO=1
@ xx, 0 SAY "Enter Segment Number: " GET mSEGNO
READ
xx=xx+1
@ xx, 0
mMORESEG=.F.
@ xx, 0 SAY "Enter More Segments Flag: " GET mMORESEG
READ
xx=xx+1
mPTVL="This is FULL NAME"+SPACE(42)
@ xx, 0 SAY "Enter Property Value: " GET mPTVL
READ
mPTVL  = LTRIM(RTRIM(mPTVL))
xx=xx+1

rtn = BDPTVLWR(mOBTYP, mOBNM, mPTNM, mSEGNO, mMORESEG, mPTVL)
DO chkrtnum WITH rtn
RETURN

PROCEDURE NBDPTVLRD
LOCAL  mOBTYP, mOBNM, mPTNM, rtn, ptvl[0], ptdyn[0], pttp[0]
PRIVATE mCNT :=.F., mDEMO :="BDPTVLRD(), Read Property Value"
OK=.T.
rtn=0
DO intro
CLEAR
xx=ROW()
xx=xx+1
mOBTYP = 01
@ xx,  0 SAY "Please enter Object type  : " GET mOBTYP
xx=xx+1
mOBNM=SPACE(46)
@ xx, 0 SAY "Please enter Object Name  : " GET mOBNM
xx=xx+1
mPTNM=SPACE(15)
@ xx,  0 SAY "Please enter Property Name: " GET mPTNM
READ
xx=xx+2
@ xx, 1 SAY "OBJECT NAME = " + mOBNM
xx=xx+1
@ xx, 1 SAY "SEARCH PROPERTY NAME = " + mPTNM
xx=xx+1

rtn = BDPTVLRD(mOBTYP, mOBNM, mPTNM, ptvl, ptdyn, pttp )
DO chkrtnum2 WITH rtn
IF .not. OK
  RETURN
ENDIF

FOR i = 1 TO LEN(ptvl)
  @ xx+1, 1 SAY "Count               = "+ LTRIM(STR(i))
  @ xx+2, 1 SAY "Property Value1     = "+ SUBSTR(ptvl[i],1,43)
  @ xx+3, 1 SAY "Property Value2     = "+ SUBSTR(ptvl[i],44,43)
  @ xx+4, 1 SAY "Property Value3     = "+ SUBSTR(ptvl[i],88,40)
  @ xx+5, 1 SAY "Property Dynamic    = "+ ptdyn[i]
  @ xx+6, 1 SAY "Property Type       = "+ pttp[i]
  WAIT
  @ xx, 1 CLEAR TO xx+7,79
NEXT
RETURN

PROCEDURE NBDPTOBAD
LOCAL  mOBTYP, mOBNM, mPTNM, mMBRTYP, mMBRNM, rtn
PRIVATE mDEMO :="BDPTOBAD(), Add Object To Set"
rtn=0
DO intro
mOBTYP = 2
@ xx, 0 SAY "Enter Object's type: " GET mOBTYP
READ
xx=xx+1
@ xx, 0
mOBNM="EVERYONE"+SPACE(41)
@ xx, 0 SAY "Enter Object Name: " GET mOBNM
READ
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+1
mPTNM="GROUP_MEMBERS"+SPACE(7)
@ xx, 0 SAY "Enter Property Name: " GET mPTNM
READ
mPTNM  = LTRIM(RTRIM(mPTNM))
xx=xx+1
mMBRTYP = 1
@ xx, 0 SAY "Enter Member's type: " GET mMBRTYP
READ
xx=xx+1
@ xx, 0
mMBRNM="SEGUE"+SPACE(41)
@ xx, 0 SAY "Enter Member's Name: " GET mMBRNM
READ
mMBRNM  = LTRIM(RTRIM(mMBRNM))
xx=xx+1

rtn = BDPTOBAD(mOBTYP, mOBNM, mPTNM, mMBRTYP, mMBRNM)
DO chkrtnum WITH rtn
RETURN

PROCEDURE NBDPTOBCK
LOCAL  mOBTYP, mOBNM, mPTNM, mMBRTYP, mMBRNM, rtn
PRIVATE mDEMO :="BDPTOBCK(), Is Object In Set"
rtn=0
DO intro
mOBTYP = 2
@ xx, 0 SAY "Enter Object's type: " GET mOBTYP
READ
xx=xx+1
@ xx, 0
mOBNM="EVERYONE"+SPACE(41)
@ xx, 0 SAY "Enter Object Name: " GET mOBNM
READ
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+1
mPTNM="GROUP_MEMBERS"+SPACE(7)
@ xx, 0 SAY "Enter Property Name: " GET mPTNM
READ
mPTNM  = LTRIM(RTRIM(mPTNM))
xx=xx+1
mMBRTYP = 1
@ xx, 0 SAY "Enter Member's type: " GET mMBRTYP
READ
xx=xx+1
@ xx, 0
mMBRNM="SEGUE"+SPACE(41)
@ xx, 0 SAY "Enter Member's Name: " GET mMBRNM
READ
mMBRNM  = LTRIM(RTRIM(mMBRNM))
xx=xx+1

rtn = BDPTOBCK(mOBTYP, mOBNM, mPTNM, mMBRTYP, mMBRNM)
DO chkrtnum1 WITH rtn
RETURN

PROCEDURE NBDPTOBDL
LOCAL  mOBTYP, mOBNM, mPTNM, mMBRTYP, mMBRNM, rtn
PRIVATE mDEMO :="BDPTOBDL(), Delete Object From Set"
rtn=0
DO intro
mOBTYP = 2
@ xx, 0 SAY "Enter Object's type: " GET mOBTYP
READ
xx=xx+1
@ xx, 0
mOBNM="EVERYONE"+SPACE(41)
@ xx, 0 SAY "Enter Object Name: " GET mOBNM
READ
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+1
mPTNM="GROUP_MEMBERS"+SPACE(7)
@ xx, 0 SAY "Enter Property Name: " GET mPTNM
READ
mPTNM  = LTRIM(RTRIM(mPTNM))
xx=xx+1
mMBRTYP = 1
@ xx, 0 SAY "Enter Member's type: " GET mMBRTYP
READ
xx=xx+1
@ xx, 0
mMBRNM="SEGUE"+SPACE(41)
@ xx, 0 SAY "Enter Member's Name: " GET mMBRNM
READ
mMBRNM  = LTRIM(RTRIM(mMBRNM))
xx=xx+1

rtn = BDPTOBDL(mOBTYP, mOBNM, mPTNM, mMBRTYP, mMBRNM)
DO chkrtnum WITH rtn
RETURN

PROCEDURE NBDOBPWCH
LOCAL  mOBTYP, mOBNM, mOLDPASS, mNEWPASS, rtn
PRIVATE mDEMO :="BDOBPWCH(), Change Object Password"
rtn=0
DO intro
mOBTYP = 1
@ xx, 0 SAY "Enter Object's type: " GET mOBTYP
READ
xx=xx+1
@ xx, 0
mOBNM="SEGUE"+SPACE(41)
@ xx, 0 SAY "Enter Object Name: " GET mOBNM
READ
xx=xx+1
mOBNM  = LTRIM(RTRIM(mOBNM))
@ xx, 0
mOLDPASS=SPACE(47)
@ xx, 0 SAY "Enter Old Password Name: " GET mOLDPASS
READ
mOLDPASS = LTRIM(RTRIM(mOLDPASS))
xx=xx+1
@ xx, 0
mNEWPASS="SECRET"+SPACE(41)
@ xx, 0 SAY "Enter New Password Name: " GET mNEWPASS
READ
mNEWPASS = LTRIM(RTRIM(mNEWPASS))
rtn = BDOBPWCH(mOBTYP, mOBNM, mOLDPASS, mNEWPASS)
DO chkrtnum WITH rtn
RETURN

PROCEDURE NBDOBPWVY
LOCAL  mOBTYP, mOBNM, mPSWRD, rtn
PRIVATE mDEMO :=" BDOBPWVY(), Verify Object Password"
rtn=0
DO intro
mOBTYP = 1
@ xx, 0 SAY "Enter Object's type: " GET mOBTYP
READ
xx=xx+1
@ xx, 0
mOBNM="SEGUE"+SPACE(41)
@ xx, 0 SAY "Enter Object Name: " GET mOBNM
READ
xx=xx+1
mOBNM  = LTRIM(RTRIM(mOBNM))
@ xx, 0
mPSWRD="SECRET"+SPACE(47)
@ xx, 0 SAY "Enter Password: " GET mPSWRD
READ
mPSWRD = LTRIM(RTRIM(mPSWRD))
xx=xx+1
rtn =  BDOBPWVY(mOBTYP, mOBNM, mPSWRD)
DO chkrtnum WITH rtn
RETURN

PROCEDURE NBDOBCHSY
LOCAL  mobtyp, mobnm, mobid, mobwsy, mobrsy, rtn, mcnt
PRIVATE mDEMO := "BDOBCHSY(), Change Object Security"
rtn=0
DO intro
mOBTYP = 1
@ xx, 0 SAY "Enter Object's type: " GET mOBTYP
READ
xx=xx+1
mOBNM="SEGUE"+SPACE(41)
@ xx, 0 SAY "Enter Object Name: " GET mOBNM
READ
xx=xx+1
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+1
mOBWSY = 'WS'
@ xx, 0 SAY "Enter Object's Write Security: " GET mOBWSY
READ
xx=xx+1
@ xx, 0
mOBRSY = 'RA'
@ xx, 0 SAY "Enter Object's Read Security: " GET mOBRSY
READ
rtn = BDOBCHSY(mOBTYP, mOBNM, mOBWSY, mOBRSY)
DO chkrtnum WITH rtn
RETURN

PROCEDURE NBDPTCHSY
LOCAL  mobtyp, mobnm, mobid, mptnm, mptwsy, mptrsy, rtn, mcnt
PRIVATE mDEMO := "BDPTCHSY(), Change Property Security"
rtn=0
DO intro
mOBTYP = 1
@ xx, 0 SAY "Enter Object's type: " GET mOBTYP
READ
xx=xx+1
mOBNM="SEGUE"+SPACE(41)
@ xx, 0 SAY "Enter Object Name: " GET mOBNM
READ
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+1
mPTNM="IDENTIFICATION"+SPACE(41)
@ xx, 0 SAY "Enter Object Name: " GET mPTNM
READ
mPTNM  = LTRIM(RTRIM(mPTNM))
xx=xx+1
mPTWSY = 'WO'
@ xx, 0 SAY "Enter Property's Write Security: " GET mPTWSY
READ
xx=xx+1
@ xx, 0
mPTRSY = 'RA'
@ xx, 0 SAY "Enter Property's Read Security: " GET mPTRSY
READ
rtn = BDPTCHSY(mOBTYP, mOBNM, mPTNM, mPTWSY, mPTRSY)
DO chkrtnum1 WITH rtn
RETURN

PROCEDURE NBDOBSN
LOCAL  obid[0], mOBTYP[0], mOBNM[0], obflag[0], obsy[0], obpt[0]
PRIVATE mDEMO :="BDOBSN(), Scan Object", rtn, mcnt
OK=.T.
rtn=0
DO intro
xx=ROW()
mOBJNM=SPACE(46)
@ xx, 0 SAY "Please enter Search Object Name: " GET mOBJNM
READ
xx=xx+1
mOBJNM  = UPPER(ALLTRIM(mOBJNM))
mOBJTYP = 0
@ xx, 0 SAY "Please enter Search Object type: " GET mOBJTYP
READ
xx=xx+1
mCN = 'N'
@ xx, 0 SAY "Do you want only a count ? (Y/N) " GET mCN
READ
mCNT = IF (UPPER(mCN)='Y',.T.,.F.)
xx=xx+2
@ xx, 1 SAY "SEARCH OBJECT NAME = " + mOBJNM

rtn = BDOBSN(mOBJTYP, mOBJNM, mCNT, @obid, @mOBTYP, @mOBNM, @obflag, @obsy, @obpt)
DO chkrtnum2 WITH rtn
IF .not. OK
  RETURN
ENDIF

FOR i = 1 TO LEN(obid)
  @ xx+1, 1 SAY "Count                  = "+ LTRIM(STR(i))
  @ xx+2, 1 SAY "Object ID              = "+ LTRIM(STR(obid[i]))
  @ xx+3, 1 SAY "Object Type            = "+ LTRIM(STR(mOBTYP[i]))
  @ xx+4, 1 SAY "Object Name            = "+ mOBNM[i]
  @ xx+5, 1 SAY "Object Flag            = "+ obflag[i]
  @ xx+6, 1 SAY "Object Security        = "+ obsy[i]
  @ xx+7, 1 SAY "Object Has Properties  = "+ IF (obpt[i]=.F.,"No","Yes")
  WAIT
  @ xx, 1 CLEAR TO xx+8,79
NEXT
RETURN

PROCEDURE NBDPTSN
LOCAL mOBTYP, mOBNM, mPTNM, ptname[0], ptdyn[0], pttp[0], ptsy[0], ptvl[0]
PRIVATE mDEMO :="BDOBSN(), Scan Property", rtn, mCNT, OK
OK=.T.
rtn=0
DO intro
xx=ROW()
xx=xx+1
mOBTYP = '  '
@ xx,  0 SAY "Please enter Object type: " GET mOBTYP
READ
mOBTYP = VAL(mOBTYP)
xx=xx+1
mOBNM=SPACE(46)
@ xx, 0 SAY "Please enter Object Name: " GET mOBNM
READ
xx=xx+1
mPTNM=SPACE(15)
@ xx,  0 SAY "Please enter Search Property Name: " GET mPTNM
READ
xx=xx+1
mCN = 'N'
@ xx, 0 SAY "Do you want only a count ? (Y/N) " GET mCN
READ
mCNT = IF (UPPER(mCN)='Y',.T.,.F.)
xx=xx+2
@ xx, 1 SAY "OBJECT NAME = " + mOBNM
xx=xx+1
@ xx, 1 SAY "SEARCH PROPERTY NAME = " + mPTNM
xx=xx+1

rtn = BDPTSN(mOBTYP, mOBNM, mPTNM, mCNT, @ptname, @ptdyn, @pttp, @ptsy, @ptvl)
DO chkrtnum2 WITH rtn
IF .not. OK
  RETURN
ENDIF

FOR i = 1 TO LEN(ptname)
  @ xx+1, 1 SAY "Count               = "+ LTRIM(STR(i))
  @ xx+2, 1 SAY "Property Name       = "+ ptname[i]
  @ xx+3, 1 SAY "Property Dynamic    = "+ ptdyn[i]
  @ xx+4, 1 SAY "Property Type       = "+ pttp[i]
  @ xx+5, 1 SAY "Property Security   = "+ ptsy[i]
  @ xx+6, 1 SAY "Property Has Values = "+ IF (ptvl[i]=.F.,"No","Yes")
  WAIT
  @ xx, 1 CLEAR TO xx+7,79
NEXT
RETURN

PROCEDURE NBDALG
LOCAL  rtn
PRIVATE mDEMO :="BDALG(), Get Bindery Access Level"
DO intro
rtn = BDALG()
? "Bindery Access Level = " + rtn
WAIT
RETURN

PROCEDURE NBDOP
LOCAL  rtn
PRIVATE mDEMO :="BDOP(), Open Bindery"
DO intro
rtn = BDOP()
DO chkrtnum1 WITH rtn
RETURN

PROCEDURE NBDCL
LOCAL  rtn
PRIVATE mDEMO :="BDCL(), Close Bindery"
DO intro
rtn = BDCL()
DO chkrtnum1 WITH rtn
RETURN

PROCEDURE USRAD
LOCAL  mOBNM, mOBFNM, mPSWRD, RTN
PRIVATE mDEMO := "USRAD_(), SS  Add User"
rtn=0
DO intro
mOBNM= "NEWUSER"+"                                 "
@ xx, 0 SAY "Enter User's Name:      " GET mOBNM
READ
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+1
mOBFNM="NEWUSER FULL NAME GOES HERE"+"             "
@ xx, 0 SAY "Enter User's Full Name: " GET mOBFNM
READ
mOBFNM  = LTRIM(RTRIM(mOBFNM))
xx=xx+1
mPSWRD="SECRET"+"                                  "
@ xx, 0 SAY "Enter User's Password:  " GET mPSWRD
READ
mPSWRD  = LTRIM(RTRIM(mPSWRD))
xx=xx+1

rtn = USRAD_(mOBNM, mOBFNM, mPSWRD)
DO chkrtnum WITH rtn
RETURN

PROCEDURE USRDL //24
LOCAL  mOBNM, RTN
PRIVATE mDEMO := "USRDL_(), SS  Delete User"
rtn=0
DO intro
mOBNM= "NEWUSER"+"                                 "
@ xx, 0 SAY "Enter User's Name:      " GET mOBNM
READ
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+1

rtn = USRDL_(mOBNM)
DO chkrtnum WITH rtn
RETURN

PROCEDURE USRSLST          //25
LOCAL  mUSRNM[0], mUSRSY[0]
PRIVATE mDEMO :="USRSLST(), SS  List Users", rtn
OK=.T.
rtn=0
DO intro
xx=ROW()
mUSRJNM=SPACE(46)
@ xx, 0 SAY "Please enter User Search String (wildcard OK): " GET mUSRJNM
READ
xx=xx+1
rtn = USRSLST_(mUSRJNM,@mUSRNM,@mUSRSY)
DO chkrtnum3 WITH rtn
IF .not. OK
  RETURN
ENDIF

@ 5,0 CLEAR TO 23,79
xx=5
yy=0
FOR i = 1 TO LEN(mUSRNM)
  IF xx=5
    @ xx,  yy SAY "Cnt User Name                Scty "
    @ xx+1,yy SAY "═══ ════════════════════════ ═════"
    xx=xx+2
  ENDIF
  @ xx,  yy    SAY TRANSFORM(i,"###")
  @ xx,  yy+4  SAY TRANSFORM(mUSRNM[i],"XXXXXXXXXXXXXXXXXXXXXXXX")
  @ xx,  yy+29 SAY TRANSFORM(mUSRSY[i],"XXXX")
  xx=xx+1
  IF xx=23
    xx=5
    IF yy=0
      yy=yy+43
    ELSE
      yy=0
      @ 23,0
      @ 23,0 SAY "Press any key to continue..."
      INKEY(0)
      @ 5,0 CLEAR TO 23,79
    ENDIF
  ENDIF
NEXT
@ 23,0
@ 23,0 SAY "Press any key to return..."
INKEY(0)
RETURN

PROCEDURE USRGRPLST          //26
LOCAL mUSRJNM, mUSRGRPNM[0]
PRIVATE mDEMO :="USRGRPLST_(), SS  List User's Groups", rtn
OK=.T.
rtn=0
DO intro
xx=ROW()
mUSRJNM=SPACE(46)
@ xx, 0 SAY "Please enter User's Name (no wildcards): " GET mUSRJNM
READ
xx=xx+1
rtn = USRGRPLST_(mUSRJNM, @mUSRGRPNM)
DO chkrtnum3 WITH rtn
IF .not. OK
  RETURN
ENDIF

@ 5,0 CLEAR TO 23,79
xx=5
yy=0
FOR i = 1 TO LEN(mUSRGRPNM)
  IF xx=5
    @ xx,  yy SAY "Cnt Group Name     "
    @ xx+1,yy SAY "═══ ═══════════════"
    xx=xx+2
  ENDIF
  @ xx,  yy    SAY TRANSFORM(i,"###")
  @ xx,  yy+4  SAY TRANSFORM(mUSRGRPNM[i],"XXXXXXXXXXXXXX")
  xx=xx+1
  IF xx=23
    xx=5
    IF yy=0
      yy=yy+43
    ELSE
      yy=0
      @ 23,0
      @ 23,0 SAY "Press any key to continue..."
      INKEY(0)
      @ 5,0 CLEAR TO 23,79
    ENDIF
  ENDIF
NEXT
@ 23,0
@ 23,0 SAY "Press any key to return..."
INKEY(0)
RETURN

PROCEDURE GRPSLST          //31
LOCAL  mGRPNM[0], mGRPSY[0]
PRIVATE mDEMO :="GRPSLST(), SS  List Groups", rtn
OK=.T.
rtn=0
DO intro
xx=ROW()
mGRPJNM=SPACE(46)
@ xx, 0 SAY "Please enter Group Search String (wildcard OK): " GET mGRPJNM
READ
xx=xx+1
rtn = GRPSLST_(mGRPJNM,@mGRPNM,@mGRPSY)
DO chkrtnum3 WITH rtn
IF .not. OK
  RETURN
ENDIF

@ 5,0 CLEAR TO 23,79
xx=5
yy=0
FOR i = 1 TO LEN(mGRPNM)
  IF xx=5
    @ xx,  yy SAY "Cnt Group Name               Scty "
    @ xx+1,yy SAY "═══ ════════════════════════ ═════"
    xx=xx+2
  ENDIF
  @ xx,  yy    SAY TRANSFORM(i,"###")
  @ xx,  yy+4  SAY TRANSFORM(mGRPNM[i],"XXXXXXXXXXXXXXXXXXXXXXXX")
  @ xx,  yy+29 SAY TRANSFORM(mGRPSY[i],"XXXX")
  xx=xx+1
  IF xx=23
    xx=5
    IF yy=0
      yy=yy+43
    ELSE
      yy=0
      @ 23,0
      @ 23,0 SAY "Press any key to continue..."
      INKEY(0)
      @ 5,0 CLEAR TO 23,79
    ENDIF
  ENDIF
NEXT
@ 23,0
@ 23,0 SAY "Press any key to return..."
INKEY(0)
RETURN

PROCEDURE USRINGRP //27
LOCAL  mOBNM, RTN
PRIVATE mDEMO := "USRINGRP_ SS  Is User In Group"
rtn=0
DO intro
mOBNM= "SEGUE" + "                                 "
@ xx, 0 SAY "Enter User's Name:      " GET mOBNM
READ
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+1
mGPNM= "EVERYONE" + "                                 "
@ xx, 0 SAY "Enter Groups's Name:      " GET mGPNM
READ
mGPNM  = LTRIM(RTRIM(mGPNM))
xx=xx+1
rtn = USRINGRP_(mOBNM,mGPNM)
DO chkrtnum4 WITH rtn
RETURN

PROCEDURE GRPAD
LOCAL  mOBNM, mOBFNM, mPSWRD, RTN
PRIVATE mDEMO := "GRPAD_(), SS  Add Group"
rtn=0
DO intro
mOBNM= "NEWGROUP"+"                                 "
@ xx, 0 SAY "Enter Group's Name:      " GET mOBNM
READ
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+1
mOBFNM="NEWGROUP FULL NAME GOES HERE"+"             "
@ xx, 0 SAY "Enter Groups's Full Name: " GET mOBFNM
READ
mOBFNM  = LTRIM(RTRIM(mOBFNM))
xx=xx+1

rtn = GRPAD_(mOBNM, mOBFNM)
DO chkrtnum WITH rtn
RETURN

PROCEDURE GRPDL
LOCAL  mOBNM, RTN
PRIVATE mDEMO := "GRPDL_(), SS  Delete Group"
rtn=0
DO intro
mOBNM= "NEWGROUP"+"                                 "
@ xx, 0 SAY "Enter Groups's Name:      " GET mOBNM
READ
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+1

rtn = GRPDL_(mOBNM)
DO chkrtnum WITH rtn
RETURN

PROCEDURE GRPUSRLST       //31
LOCAL mGRPNM, mGRPUSRNM[0]
PRIVATE mDEMO :="GRPUSRLST_(), SS  List Group's Users", rtn
OK=.T.
rtn=0
DO intro
xx=ROW()
mGRPNM=SPACE(46)
@ xx, 0 SAY "Please enter Groups's Name (no wildcards): " GET mGRPNM
READ
xx=xx+1
rtn = GRPUSRLST_(mGRPNM, @mGRPUSRNM)
DO chkrtnum3 WITH rtn
IF .not. OK
  RETURN
ENDIF

@ 5,0 CLEAR TO 23,79
xx=5
yy=0
FOR i = 1 TO LEN(mGRPUSRNM)
  IF xx=5
    @ xx,  yy SAY "Cnt User Name"
    @ xx+1,yy SAY "═══ ═══════════════"
    xx=xx+2
  ENDIF
  @ xx,  yy    SAY TRANSFORM(i,"###")
  @ xx,  yy+4  SAY TRANSFORM(mGRPUSRNM[i],"XXXXXXXXXXXXXX")
  xx=xx+1
  IF xx=23
    xx=5
    IF yy=0
      yy=yy+43
    ELSE
      yy=0
      @ 23,0
      @ 23,0 SAY "Press any key to continue..."
      INKEY(0)
      @ 5,0 CLEAR TO 23,79
    ENDIF
  ENDIF
NEXT
@ 23,0
@ 23,0 SAY "Press any key to return..."
INKEY(0)
RETURN

PROCEDURE GRPUSRAD   //32
LOCAL  mOBNM, RTN
PRIVATE mDEMO := "GRPUSRAD_() SS  Add User To Group"
rtn=0
DO intro
mOBNM= "SEGUE" + "                                    "
@ xx, 0 SAY "Enter User's Name:      " GET mOBNM
READ
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+1
mGPNM= "EVERYONE" + "       "
@ xx, 0 SAY "Enter Groups's Name:      " GET mGPNM
READ
mGPNM  = LTRIM(RTRIM(mGPNM))
xx=xx+1
rtn = GRPUSRAD_(mOBNM, mGPNM)
DO chkrtnum WITH rtn
RETURN

PROCEDURE GRPUSRDL   //33
LOCAL  mOBNM, RTN
PRIVATE mDEMO := "GRPUSRDL_() SS  Delete User From Group"
rtn=0
DO intro
mOBNM= "SEGUE" + "                                    "
@ xx, 0 SAY "Enter User's Name:      " GET mOBNM
READ
mOBNM  = LTRIM(RTRIM(mOBNM))
xx=xx+1
mGPNM= "EVERYONE" + "       "
@ xx, 0 SAY "Enter Groups's Name:      " GET mGPNM
READ
mGPNM  = LTRIM(RTRIM(mGPNM))
xx=xx+1
rtn = GRPUSRDL_(mOBNM, mGPNM)
DO chkrtnum WITH rtn
RETURN

PROCEDURE SUPLST //34
LOCAL  mOBTYP, mUSRJNM, mUSRNM[0], mOBTP[0], rtn
PRIVATE mDEMO :="SUPLST_(), SS  List Users w/Supervisor Security"
OK=.T.
rtn=0
do intro
xx=row()
mOBTYP = 0
@ xx,  0 say "Please enter Object type: " get mOBTYP
read
xx=xx+1
mUSRJNM=space(46)
@ xx, 0 say "Please enter Object Search String (wildcard OK): " get mUSRJNM
read
xx=xx+1
rtn = SUPLST_(mOBTYP,mUSRJNM,@mUSRNM,@mOBTP)
*? rtn
*wait
do chkrtnum3 with rtn
if .not. OK
  return
endi

@ 5,0 clear to 23,79
xx=5
yy=0
for i = 1 to len(mUSRNM)
  if xx=5
    @ xx,  yy say "Cnt User Name                Type"
    @ xx+1,yy say "=== ======================== ===="
    xx=xx+2
  endi
    @ xx,  yy    say trans(i,"###")
    @ xx,  yy+4  say trans(mUSRNM[i],"XXXXXXXXXXXXXXXXXXXXXXXX")
    @ xx,  yy+30 say trans(mOBTP[i],"###")
  xx=xx+1
  if xx=23
    xx=5
    if yy=0
      yy=yy+43
    else
      yy=0
      @ 23,0
      @ 23,0 say "Press any key to continue..."
      inkey(0)
      @ 5,0 clear to 23,79
    endi
  endi
next
@ 23,0
@ 23,0 say "Press any key to return..."
inkey(0)
return